home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / aandbf1g / form1.frm < prev    next >
Text File  |  1999-08-22  |  10KB  |  365 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "Generic Multiple CD Player"
  5.    ClientHeight    =   1905
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   7065
  9.    Icon            =   "Form1.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    ScaleHeight     =   1905
  13.    ScaleWidth      =   7065
  14.    StartUpPosition =   2  'CenterScreen
  15.    Begin VB.Timer Timer1 
  16.       Interval        =   1000
  17.       Left            =   4200
  18.       Top             =   960
  19.    End
  20.    Begin VB.CommandButton Command8 
  21.       Caption         =   "About..."
  22.       Height          =   255
  23.       Left            =   120
  24.       TabIndex        =   11
  25.       Top             =   120
  26.       Width           =   1215
  27.    End
  28.    Begin VB.PictureBox Picture1 
  29.       BackColor       =   &H00004040&
  30.       Height          =   735
  31.       Left            =   2520
  32.       ScaleHeight     =   675
  33.       ScaleWidth      =   4395
  34.       TabIndex        =   9
  35.       Top             =   120
  36.       Width           =   4455
  37.       Begin VB.Image Image1 
  38.          Height          =   330
  39.          Left            =   0
  40.          Picture         =   "Form1.frx":08CA
  41.          Top             =   0
  42.          Width           =   2340
  43.       End
  44.       Begin VB.Label Label3 
  45.          Alignment       =   1  'Right Justify
  46.          BackStyle       =   0  'Transparent
  47.          BeginProperty Font 
  48.             Name            =   "Arial"
  49.             Size            =   15.75
  50.             Charset         =   0
  51.             Weight          =   700
  52.             Underline       =   0   'False
  53.             Italic          =   0   'False
  54.             Strikethrough   =   0   'False
  55.          EndProperty
  56.          ForeColor       =   &H0000C0C0&
  57.          Height          =   495
  58.          Left            =   1680
  59.          TabIndex        =   12
  60.          Top             =   120
  61.          Width           =   2535
  62.       End
  63.       Begin VB.Label Label2 
  64.          BackColor       =   &H00008080&
  65.          BackStyle       =   0  'Transparent
  66.          Caption         =   "Current CD Drive"
  67.          ForeColor       =   &H0000C0C0&
  68.          Height          =   255
  69.          Left            =   120
  70.          TabIndex        =   10
  71.          Top             =   360
  72.          Width           =   3135
  73.       End
  74.    End
  75.    Begin VB.CommandButton Command7 
  76.       Caption         =   "Close"
  77.       Height          =   495
  78.       Left            =   6120
  79.       TabIndex        =   7
  80.       Top             =   1320
  81.       Width           =   855
  82.    End
  83.    Begin VB.CommandButton Command6 
  84.       Caption         =   "Eject"
  85.       Height          =   495
  86.       Left            =   5280
  87.       TabIndex        =   6
  88.       Top             =   1320
  89.       Width           =   855
  90.    End
  91.    Begin VB.CommandButton CD 
  92.       Height          =   255
  93.       Index           =   0
  94.       Left            =   120
  95.       TabIndex        =   5
  96.       Top             =   960
  97.       Visible         =   0   'False
  98.       Width           =   735
  99.    End
  100.    Begin VB.CommandButton Command5 
  101.       Caption         =   "Stop"
  102.       Height          =   495
  103.       Left            =   3960
  104.       TabIndex        =   4
  105.       Top             =   1320
  106.       Width           =   1095
  107.    End
  108.    Begin VB.CommandButton Command4 
  109.       Caption         =   "Pause"
  110.       Height          =   495
  111.       Left            =   3000
  112.       TabIndex        =   3
  113.       Top             =   1320
  114.       Width           =   975
  115.    End
  116.    Begin VB.CommandButton Command3 
  117.       Caption         =   "Track>>"
  118.       Height          =   495
  119.       Left            =   2040
  120.       TabIndex        =   2
  121.       Top             =   1320
  122.       Width           =   975
  123.    End
  124.    Begin VB.CommandButton Command2 
  125.       Caption         =   "Play"
  126.       Height          =   495
  127.       Left            =   1080
  128.       TabIndex        =   1
  129.       Top             =   1320
  130.       Width           =   975
  131.    End
  132.    Begin VB.CommandButton Command1 
  133.       Caption         =   "<<Track"
  134.       Height          =   495
  135.       Left            =   120
  136.       TabIndex        =   0
  137.       Top             =   1320
  138.       Width           =   975
  139.    End
  140.    Begin VB.Label Label1 
  141.       Caption         =   "Available Audio CD Drives"
  142.       Height          =   255
  143.       Left            =   120
  144.       TabIndex        =   8
  145.       Top             =   720
  146.       Width           =   2055
  147.    End
  148. End
  149. Attribute VB_Name = "Form1"
  150. Attribute VB_GlobalNameSpace = False
  151. Attribute VB_Creatable = False
  152. Attribute VB_PredeclaredId = True
  153. Attribute VB_Exposed = False
  154. Dim CurrentCd As String
  155. Dim mssg As String * 255
  156. Public Sub Detect_CDs()
  157.  
  158. Dim SmallString As String
  159. Dim NextDrive As String
  160. Static z As Integer
  161.        
  162. alldrives$ = Space$(64)
  163. 'Get all drives on your PC as one long string
  164. ret& = GetLogicalDriveStrings(Len(alldrives$), alldrives$)
  165. 'trim off any trailing spaces. AllDrives$
  166. 'now contains all the drive letters.
  167. alldrives$ = Left$(alldrives$, ret&)
  168.  
  169.  
  170. ' "AllDrives$"  contains a string of all of your drives
  171. 'in your computer, but there is a character "chr$(0)"
  172. 'between each drive letter that we must filter out.
  173. 'We will use the "FOR NEXT" function to do this.
  174.    
  175. For k = 1 To Len(alldrives$)
  176.   SmallString = Mid$(alldrives$, k, 1) 'Get one character at a time
  177.   If SmallString = Chr$(0) Then
  178.            SmallString = ""     'remove unwanted character
  179.            DriveType& = GetDriveType(NextDrive) 'Check if it is a CD drive
  180.            If DriveType = 5 Then
  181.               If CD(0).Caption = "" Then 'Our first button needs to be updated before the others.
  182.                 CD(0).Caption = UCase$(NextDrive)
  183.                 CD(z).Visible = True
  184.                 CurrentCd = UCase$(NextDrive)
  185.               Else
  186.                 'Since this is a CD drive, make a button for it.
  187.                 'This code below creates command buttons
  188.                  z = z + 1
  189.                  Load CD(z)
  190.                  CD(z).Caption = UCase$(NextDrive)
  191.                  CD(z).Left = (CD(z - 1).Left) + (CD(z - 1).Width)
  192.                  CD(z).Visible = True
  193.               End If
  194.            End If
  195.            NextDrive = "" 'Now that a drive was detected, clear the
  196.                           'string for new info
  197.     End If
  198.       
  199. NextDrive = NextDrive & SmallString
  200.    
  201. Next k
  202.  
  203. If CD(0).Caption = "" Then
  204.   MsgBox "No Audio CDs were detected", vbInformation, ""
  205.   End
  206. Else
  207. UpDate_Cds
  208. End If
  209.  
  210. End Sub
  211.  
  212. Private Sub CD_Click(Index As Integer)
  213.   i = mciSendString("stop cd", 0&, 0, 0)
  214.   i = mciSendString("close cd", 0&, 0, 0)
  215.   CurrentCd = CD(Index).Caption
  216.  
  217. UpDate_Cds
  218. End Sub
  219.  
  220.  
  221. Private Sub Command1_Click()
  222. Dim numTracks As Integer
  223. Dim CurTrack As Integer
  224.  
  225.  
  226. 'Get the current track
  227. rc = mciSendString("status cd current track", mssg, 255, 0)
  228. CurTrack = Str(mssg)
  229.  
  230. 'Get total number of tracks
  231. rc = mciSendString("status cd number of tracks wait", mssg, 255, 0)
  232. numTracks = Str(mssg)
  233.  
  234. 'Check to see if CD is playing
  235. rc = mciSendString("status cd mode", mssg, 255, 0)
  236.  
  237. If Left$(mssg, 7) = "playing" Then
  238.     If CurTrack = 1 Then
  239.          rc = mciSendString("play cd from " & numTracks, mssg, 255, 0)
  240.     Else
  241.          rc = mciSendString("play cd from " & CurTrack - 1, mssg, 255, 0)
  242.     End If
  243. Else
  244.     If CurTrack = 1 Then
  245.          rc = mciSendString("seek cd to " & numTracks, mssg, 255, 0)
  246.     Else
  247.          rc = mciSendString("seek cd to " & CurTrack - 1, mssg, 255, 0)
  248.     End If
  249. End If
  250. End Sub
  251.  
  252. Private Sub Command2_Click()
  253.   i = mciSendString("play cd", 0&, 0, 0)
  254. End Sub
  255.  
  256. Private Sub Command3_Click()
  257. Dim mssg As String * 255
  258. Dim numTracks As Integer
  259. Dim CurTrack As Integer
  260.  
  261.  
  262. 'Get the current track
  263. rc = mciSendString("status cd current track", mssg, 255, 0)
  264. CurTrack = Str(mssg)
  265.  
  266. 'Get total number of tracks
  267. rc = mciSendString("status cd number of tracks wait", mssg, 255, 0)
  268. numTracks = Str(mssg)
  269.  
  270. 'Check to see if CD is playing
  271. rc = mciSendString("status cd mode", mssg, 255, 0)
  272.  
  273. If Left$(mssg, 7) =